//=============================================================================
///	Read S-expression
//=============================================================================

#include "sstream.h"
#include "sexp.h"
#include "ssym.h"
#include "sstring.h"
#include "sfpnum.h"
#include "sutil.h"
#include "seval.h"
#include "shash.h"
#include "smem.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include <assert.h>

#ifndef	FALSE
#define	FALSE	(0)
#define	TRUE	(1)
#endif


#define	tOther				(10)	///< other (nil, t, eof)

/// define
#define	TYPE_BITS			(8)
#define	VAL_MASK			(-1 << TYPE_BITS)
#define	MAKE_SEXP(t, val)	((t) | ((val) << TYPE_BITS))

/// constant value
//#define	cFail				MAKE_SEXP(tOther, -1)
#define	cDot				MAKE_SEXP(tOther, -2)
#define	cNL							/* new line */			MAKE_SEXP(tOther, 3)


// (1 . )
const char ERR_READ_EMPTY_AFTER_DOT[] = "read empty after dot";
// ( . 1)
const char ERR_READ_DOT_FIRST[] = "read dot first";
// (x . y z)
const char ERR_READ_ILLEGAL_DOT_LIST[] = "illegal dot list";
// (1 #<eof>
const char ERR_READ_NO_CLOSE_PAREN[] = "no close paren (from ~a:~a)";
// 
const char ERR_READ_ILLEGAL_CHAR[] = "illegal char: ~a";
const char ERR_READ_ILLEGAL_EOF[] = "illegal EOF";
const char ERR_READ_STRING_NOT_TERMINATE[] = "string not terminate";

const char ERR_READ_ILLEGAL_HEX_CHAR[] = "illegal hex char: ~a";
const char ERR_READ_ILLEGAL_BIN_CHAR[] = "illegal bin char: ~a";
const char ERR_READ_ILLEGAL_OCT_CHAR[] = "illegal oct char: ~a";



// scheme's valid char: !$%&*+-./:<=>?@^_~
static int is_delimiter(int c) {
	static const char Delimiter[] = " \t\n()',#[]{}|";
	return strchr(Delimiter, c) != NULL;
}



#define	GETCH(strm)			((strm)->vtbl->getch(strm))
#define	UNGETCH(strm, c)	((strm)->vtbl->ungetch(strm, c))


INLINE SExp sexp(int x) { SExp s; s.i = x; return s; }

static SExp read_rec(Stream* strm, int* plineno, int* pcolno);


/// Skip white spaces
static int skip_space(Stream* strm) {
	for (;;) {
		int c = GETCH(strm);
		if (c != ' ' && c != '\t') {
			return c;
		}
	}
}

/// Skip to end of line
static void skip_line_comment(Stream* strm) {
	for (;;) {
		int c = GETCH(strm);
		if (c == EOF || c == '\n')	break;
	}
}

/// Skip block comment, #|...|#
static void skip_block_comment(Stream* strm) {
	for (;;) {
		int c = GETCH(strm);
		if (c == EOF)	break;
		if (c == '|') {
			c = GETCH(strm);
			if (c == '#')	break;
		}
	}
}


/// Reserved word?
static SExp reserved(const char* symb, const char* end) {
	struct {
		const char* str;
		SExp sexp;
	} static const tbl[] = {
		{	"\x01.",	cDot	},
	};
	const int N = sizeof(tbl)/sizeof(*tbl);
	int l = end - symb;
	int i;
	for (i=0; i<N; ++i) {
		const char* p = tbl[i].str;
		if (p[0] == l && strncmp(symb, p+1, l) == 0) {
			return tbl[i].sexp;
		}
	}
	return nil;
}


/// Read string
/**
	Read "...", and return string
	Have limit length

	@todo: charset (SJIS, EUC, UTF-8, ...)
*/
static SExp string_reader(Stream* strm, int c, int lineno, int colno) {
	char str[256];
	char* end = str + sizeof(str) - 1;
	char* q = str;
	for (; c = GETCH(strm), c != '"'; ) {
		if (c == EOF) {
			error(ERR_READ_STRING_NOT_TERMINATE);
			break;
		}
		if (c == '\\') {
			c = GETCH(strm);
			switch (c) {
			default:		// other: nothing
				if (q < end) {
					*q++ = '\\';
				}
				break;
			case 't':	c = '\t';	break;
			case 'n':	c = '\n';	break;
			case '0':	c = '\0';	break;
			case '"':	c = '"';	break;
			case '\n':	continue;		// line continue
			}
		}
		if (q < end) {
			*q++ = c;
		}
	}
	*q = '\0';

	return gen_str(str, q - str);
}


/// Read cell
/**
	Read (...), and return list
*/
static SExp lpar_reader(Stream* strm, int c, int lineno, int colno) {
	SExp res;
	push_stack(nil);
	for (;;) {
		int lineno, colno;
		SExp s = read_rec(strm, &lineno, &colno);
		if (eq(s, sERR) || eq(s, sEOF)) {
			res = pop_nrev_stack();
			goto L_ret;
		}
//		if (s.i == cNL)		continue;
		if (s.i == cDot)	break;

//		cd = cons_ext(s, nil, strm->fn, lineno, colno);
		push_stack(s);
		cons_on_stack();
	}

	// dot appear
	{
		SExp l = ref_stack(1);
		SExp s;
		res = nreverse(l);
		push_stack(res);		// save

		do {
			int lineno, colno;
			s = read_rec(strm, &lineno, &colno);
		} while (s.i == cNL);

		if (eq(s, sERR) || eq(s, sEOF)) {
			// ERR: (x .)
			error(ERR_READ_EMPTY_AFTER_DOT);
		} else {
			int err = FALSE;
			int err2;
			int lineno, colno;
			if (nilp(res)) {
				// ERR: (. x)
				error(ERR_READ_DOT_FIRST);
				err = TRUE;
			} else {
				rplacd(l, s);
			}

			err2 = FALSE;
			for (; s = read_rec(strm, &lineno, &colno), !eq(s, sERR) && !eq(s, sEOF); ) {
				if (s.i != cNL)	err2 = TRUE;
			}
			if (err2 && !err) {
				// ERR: (x . y z)
				error(ERR_READ_ILLEGAL_DOT_LIST);
			}
		}
		pop_stack(2);
		goto L_ret;
	}

L_ret:;
	{
		int c = GETCH(strm);
		if (c != ')') {
			UNGETCH(strm, c);
			error(ERR_READ_NO_CLOSE_PAREN, strm->fn, fixnum2s(lineno));
		}
		return res;
	}
}

static int hex(int c) {
	if ('0' <= c && c <= '9')		return c - '0';
	else if ('A' <= c && c <= 'F')	return c - ('A' - 10);
	else if ('a' <= c && c <= 'f')	return c - ('a' - 10);
	return -1;
}

static int bin(int c) {
	if ('0' <= c && c <= '1')		return c - '0';
	return -1;
}

static int oct(int c) {
	if ('0' <= c && c <= '7')		return c - '0';
	return -1;
}

static SExp read_base_num(Stream* strm, int shift, int (*getnum)(int), const char* errfmt) {
	int flag = +1;
	int x = 0;
	int c;

	c = GETCH(strm);
	if (c == '+') {
	} else if (c == '-') {
		flag = -1;
	} else {
		UNGETCH(strm, c);
	}

	for (;;) {
		int h;
		c = GETCH(strm);
		if (is_delimiter(c)) {
			UNGETCH(strm, c);
			break;
		}

		h = (getnum)(c);
		if (h < 0) {
			return error(errfmt);
		}
		x = (x << shift) + h;
	}
	return fixnum2s(flag * x);
}

static SExp read_hex(Stream* strm) {
	return read_base_num(strm, 4, hex, ERR_READ_ILLEGAL_HEX_CHAR);
}

static SExp read_bin(Stream* strm) {
	return read_base_num(strm, 1, bin, ERR_READ_ILLEGAL_BIN_CHAR);
}

static SExp read_oct(Stream* strm) {
	return read_base_num(strm, 3, oct, ERR_READ_ILLEGAL_OCT_CHAR);
}


static SExp symbol_or_number_reader(Stream* strm) {
	char symb[256];		// @fixme: release limited
	char* end = symb + sizeof(symb) - 1;
	char* q = symb;
	int c = GETCH(strm);
	// search delimiter
	for (; c != EOF && !is_delimiter(c); c = GETCH(strm)) {
		if (q < end) {
			*q++ = c;
		}
	}
	UNGETCH(strm, c);
	*q = '\0';
	if (q == symb) {		// not read anything: for instance, )
		return sERR;
	} else {
		SExp num = make_number(symb);
		if (!nilp(num)) {
			return num;
		} else {
			SExp s = reserved(symb, q);
			if (nilp(s)) {
				s = intern(symb);
			}
			return s;
		}
	}
}




typedef SExp (*ReaderFunc)(Stream* strm, int c, int lineno, int colno);

static SExp quote_reader(Stream* strm, int c, int lineno, int colno) {
	SExp r;
	SExp s = read_rec(strm, &lineno, &colno);
	push_stack(s);
	r = cons_ext(intern("quote"), cons_ext(s, nil, strm->fn, lineno, colno), strm->fn, lineno, colno);
	pop_stack(1);
	return r;
}

static SExp bquote_reader(Stream* strm, int c, int lineno, int colno) {
	SExp r, v;
	SExp s = read_rec(strm, &lineno, &colno);
	push_stack(s);
	v = cons_ext(s, nil, strm->fn, lineno, colno);
	push_stack(v);
	r = cons_ext(intern("quasiquote"), v, strm->fn, lineno, colno);
	pop_stack(2);
	return r;
}

static SExp comma_reader(Stream* strm, int c, int lineno, int colno) {
	SExp fn, s, r, v;
	c = GETCH(strm);
	if (c != '@') {
		UNGETCH(strm, c);
		fn = intern("unquote");
	} else {
		fn = intern("unquote-splicing");
	}
	s = read_rec(strm, &lineno, &colno);
	push_stack(s);
	v = cons_ext(s, nil, strm->fn, lineno, colno);
	push_stack(v);
	r = cons_ext(fn, v, strm->fn, lineno, colno);
	pop_stack(2);
	return r;
}

static SExp semicol_reader(Stream* strm, int c, int lineno, int colno) {
	skip_line_comment(strm);
	return sUNDEF;
}

static SExp sharp_reader(Stream* strm, int c, int lineno, int colno) {
	c = GETCH(strm);
	switch (c) {
	default:
		return error(ERR_READ_ILLEGAL_CHAR, c);
	case '|':
		skip_block_comment(strm);
		return sUNDEF;
	case '!':		// for shebang
		skip_line_comment(strm);
		return sUNDEF;
	case '\\':		// char
		c = GETCH(strm);
		if (c == EOF) {
			return error(ERR_READ_ILLEGAL_EOF);
		} else {
			return char2s(c);
		}
	case 'x':		// hex decimal
		return read_hex(strm);
	case 'b':		// binary decimal
		return read_bin(strm);
	case 'o':		// oct decimal
		return read_oct(strm);
	}
}




static ReaderFunc reader_tbl[0x80-0x20];		// 0x20~0x7f
static SExp reader_stbl[0x80-0x20];				// 0x20~0x7f

static SExp read_sfn(Stream* strm, int c, int lineno, int colno) {
	SExp f = reader_stbl[c - ' '];
	SExp args = list2(ptr2s(strm), char2s(c));
	SExp r;
	push_stack(args);
	r = apply(f, args, FALSE);
	pop_stack(1);
	return r;
}

static SExp dispatcher(Stream* strm, int c, int lineno, int colno) {
	unsigned int idx = c - ' ';
	SExp h = reader_stbl[idx];
	int c2 = GETCH(strm);
	assert(type_of(h) == tHash);
	if (nilp(h)) {
		return error("not dispatch character");
	} else {
		SExp f = gethash(char2s(c2), &h.ptr->hash);
		if (eq(f, sUNDEF)) {
			return error("not dispatch character");
		} else {
			SExp args = list3(ptr2s(strm), char2s(c), char2s(c2));
			SExp r;
			push_stack(args);
			r = apply(f, args, FALSE);
			pop_stack(1);
			return r;
		}
	}
}





static ReaderFunc get_reader_func(unsigned char c) {
	const unsigned char BASE = ' ';
	unsigned char idx = c - BASE;
	if (idx < 0x80 - BASE) {
		return reader_tbl[idx];
	} else {
		return NULL;
	}
}

static void set_macro_chr1_cfn(int c, ReaderFunc f) {
	unsigned int idx = c - ' ';
	if (idx < 0x80 - ' ') {
		reader_stbl[idx] = nil;
		reader_tbl[idx] = f;
	}
}

static void set_macro_chr1_lfn(int c, SExp f) {
	unsigned int idx = c - ' ';
	if (idx < 0x80 - ' ') {
		reader_stbl[idx] = f;
		reader_tbl[idx] = nilp(f) ? NULL : read_sfn;
	}
}

static int set_dispatch_reader_tbl(int c) {
	unsigned int idx = c - ' ';
	if (idx < 0x80 - ' ') {
		if (reader_tbl[idx] != dispatcher) {
			reader_tbl[idx] = dispatcher;
			reader_stbl[idx] = make_hash_table();
			return TRUE;
		}
	}
	return FALSE;
}

static int set_dispatch_reader_func(int c1, int c2, SExp f) {
	unsigned int idx = c1 - ' ';
	if (idx < 0x80 - ' ') {
		if (reader_tbl[idx] == dispatcher) {
			SExp h = reader_stbl[idx];
			assert(type_of(h) == tHash);
			sethash(char2s(c2), &h.ptr->hash, f);
			return TRUE;
		}
	}
	return FALSE;
}

static SExp get_dispatch_reader_func(int c1, int c2) {
	unsigned int idx = c1 - ' ';
	if (idx < 0x80 - ' ') {
		if (reader_tbl[idx] == dispatcher) {
			SExp h = reader_stbl[idx];
			assert(type_of(h) == tHash);
			return gethash(char2s(c2), &h.ptr->hash);
		}
	}
	return sUNDEF;
}





void init_reader(void) {
	int i;
	for (i=0; i<sizeof(reader_stbl)/sizeof(*reader_stbl); ++i) {
		reader_stbl[i] = nil;
	}

	set_macro_chr1_cfn('"', string_reader);
	set_macro_chr1_cfn('\'', quote_reader);
	set_macro_chr1_cfn('(', lpar_reader);
	set_macro_chr1_cfn(',', comma_reader);
	set_macro_chr1_cfn(';', semicol_reader);
	set_macro_chr1_cfn('`', bquote_reader);

	set_macro_chr1_cfn('#', sharp_reader);		// @fixme: use dispatch-macro-charcter
}



/// Recursive read
/**
	Top of read
*/
static SExp read_rec(Stream* strm, int* plineno, int* pcolno) {
	int c;

	for (;;) {
		c = skip_space(strm);
		if (c == EOF)	return sEOF;
//		if (c == '\n')	return sexp(cNL);
		if (c == '\n' || c == '\r')	continue;

		*plineno = strm->lineno;
		*pcolno = strm->colno;

		{
			ReaderFunc fn = get_reader_func(c);
			if (fn != NULL) {
				SExp r = fn(strm, c, *plineno, *pcolno);
				if (!eq(r, sUNDEF))	return r;
			} else {
				UNGETCH(strm, c);
				return symbol_or_number_reader(strm);
			}
		}
	}
}


//=============================================================================

SExp read(SExp strm) {
	int lineno, colno;
	SExp s;
	strm = type_check(strm, tStream);
	s = read_rec(&strm.ptr->stream, &lineno, &colno);
	if (eq(s, sERR)) {
		int c = GETCH(&strm.ptr->stream);	// drop illegal char
		error(ERR_READ_ILLEGAL_CHAR, fixnum2s(c));
		s = nil;
	}
//	if (eq(s, sEOF)) {
//		s = nil;
//	}
	return s;

}

void set_macro_character(SExp chr, SExp f) {
	SExp cc = type_check(chr, tChar);
	int c = s2char(cc);
	set_macro_chr1_lfn(c, f);
}

SExp get_macro_character(SExp chr) {
#if 0
	SExp singletbl = car(mactbl);
	SExp r = assoc(chr, singletbl);
	if (nilp(r)) {
		return nil;
	} else {
		return cdr(r);
	}
#endif
	assert(!"not implemented");
	return nil;
}

int make_dispatch_macro_character(SExp chr1) {
	SExp cc = type_check(chr1, tChar);
	int c = s2char(cc);
	return set_dispatch_reader_tbl(c);
}

int set_dispatch_macro_character(SExp chr1, SExp chr2, SExp f) {
	int c1, c2;
	c1 = s2char(chr1);
	c2 = s2char(chr2);
	return set_dispatch_reader_func(c1, c2, f);
}

SExp get_dispatch_macro_character(SExp chr1, SExp chr2) {
	int c1, c2;
	c1 = s2char(chr1);
	c2 = s2char(chr2);
	return get_dispatch_reader_func(c1, c2);
}


void mark_reader(void) {
	int i;
	for (i=0; i<sizeof(reader_stbl)/sizeof(*reader_stbl); ++i) {
		SMARK(reader_stbl[i]);
	}
}
